home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / intrfc62.zip / CODE.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-25  |  1KB  |  56 lines
  1. unit code;
  2.  
  3. interface
  4.  
  5. procedure print_dump(seg:byte);
  6.  
  7. implementation
  8.  
  9. uses globals,head,blocks,reloc,dump,util;
  10.  
  11. procedure print_dump(seg:byte);
  12. var
  13.   codebase,codeofs,codelimit,
  14.   base,ofs,limit : word;
  15.   code_block : block_ptr;
  16.   block : byte_array_ptr;
  17. begin
  18.   case seg of
  19.   code_seg : begin
  20.         if header^.code_size = 0 then
  21.           exit;
  22.         writeln;
  23.         writeln('Emitted code');
  24.         codebase :=header^.ofs_code_blocks;
  25.         codelimit := header^.ofs_const_blocks-codebase;
  26.      end;
  27.  
  28.   const_seg : begin
  29.         if header^.const_size = 0 then
  30.           exit;
  31.         writeln;
  32.         writeln('Emitted consts');
  33.         codebase :=header^.ofs_const_blocks;
  34.         codelimit := header^.ofs_var_blocks-codebase;
  35.      end;
  36.   end;
  37.   base := 0;
  38.   codeofs := 0;
  39.   while codeofs < codelimit do
  40.   begin
  41.     code_block := add_offset(buffer,codebase+codeofs);
  42.     write('---');
  43.     case seg of
  44.       code_seg:  write_code_block_name(code_block^.owner);
  45.       const_seg: write_const_block_name(code_block^.owner);
  46.     end;
  47.     write('---(block ',hexword2(codeofs),')');
  48.     ofs := 0;
  49.     limit := code_block^.size;
  50.     dumpbytes(add_offset(code_buf,base)^,0,limit);
  51.     inc(base,limit);
  52.     inc(codeofs,sizeof(block_rec));
  53.   end;
  54. end;
  55.  
  56. end.